Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmbox / msgbox.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-02-09 | 30.5 KB | 802 lines

VERSION 2.00 Begin Form Form1 BackColor = &H00C0C0C0& Caption = "Visual Basic Message Box" ClientHeight = 5040 ClientLeft = 2085 ClientTop = 2040 ClientWidth = 7965 Height = 5415 Icon = MSGBOX.FRX:0000 KeyPreview = -1 'True Left = 2040 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5040 ScaleWidth = 7965 Top = 1710 Width = 8055 Begin SSPanel sfxFormFX Alignment = 0 'Left Justify - TOP BackColor = &H00C0C0C0& BevelInner = 2 'Raised BorderWidth = 1 Font3D = 0 'None Height = 5040 Left = 45 RoundedCorners = 0 'False TabIndex = 6 Top = 30 Width = 7920 Begin SSPanel p3dCmdButtons BackColor = &H00C0C0C0& BevelInner = 1 'Inset BorderWidth = 1 Font3D = 0 'None ForeColor = &H00FFFFFF& Height = 1230 Left = 4575 TabIndex = 25 Top = 3630 Width = 3210 Begin SSCommand c3dActions Caption = "Exit" Font3D = 3 'Inset w/light shading ForeColor = &H00000080& Height = 525 Index = 3 Left = 1620 TabIndex = 29 TabStop = 0 'False Top = 630 Width = 1500 End Begin SSCommand c3dActions Caption = "&View MsgBox" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 525 Index = 2 Left = 75 TabIndex = 28 TabStop = 0 'False Top = 630 Width = 1500 End Begin SSCommand c3dActions Caption = "> Clip&board" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 525 Index = 1 Left = 1620 TabIndex = 27 TabStop = 0 'False Top = 75 Width = 1500 End Begin SSCommand c3dActions Caption = "> Code &Window" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 525 Index = 0 Left = 75 TabIndex = 26 TabStop = 0 'False Top = 75 Width = 1500 End End Begin SSFrame f3dModalarity Caption = "Modalarity" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 1320 Left = 2460 TabIndex = 23 Top = 3540 Width = 2040 Begin SSOption o3dModality Caption = "System Moda&l" Font3D = 0 'None Height = 285 Index = 1 Left = 180 TabIndex = 24 TabStop = 0 'False Top = 795 Width = 1700 End Begin SSOption o3dModality Caption = "Appli&cation Modal" Font3D = 0 'None Height = 240 Index = 0 Left = 180 TabIndex = 5 Top = 375 Value = -1 'True Width = 1800 End End Begin SSFrame f3dDefaultButton Caption = "Default Button" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 1200 Left = 90 TabIndex = 15 Top = 3660 Width = 2250 Begin SSOption o3dDefaultButton Caption = "&3rd -" Font3D = 0 'None Height = 240 Index = 2 Left = 195 TabIndex = 17 TabStop = 0 'False Top = 850 Width = 1980 End Begin SSOption o3dDefaultButton Caption = "&2nd -" Font3D = 0 'None Height = 240 Index = 1 Left = 195 TabIndex = 16 TabStop = 0 'False Top = 550 Width = 1980 End Begin SSOption o3dDefaultButton Caption = "&1st -" Font3D = 0 'None Height = 240 Index = 0 Left = 195 TabIndex = 4 Top = 285 Value = -1 'True Width = 1980 End End Begin SSFrame f3dIcon Caption = "Icon" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 1140 Left = 2445 TabIndex = 22 Top = 2295 Width = 5355 Begin SSRibbon gpbIcon BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 570 Index = 4 Left = 4560 PictureDisabled = MSGBOX.FRX:0302 PictureDnChange = 0 'Use 'PictureUp' Bitmap Unchanged PictureUp = MSGBOX.FRX:0B3C Top = 270 Value = -1 'True Width = 570 End Begin SSRibbon gpbIcon BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 570 Index = 3 Left = 3480 PictureDisabled = MSGBOX.FRX:1376 PictureDnChange = 0 'Use 'PictureUp' Bitmap Unchanged PictureUp = MSGBOX.FRX:1BB0 Top = 270 Width = 570 End Begin SSRibbon gpbIcon BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 570 Index = 2 Left = 2400 PictureDisabled = MSGBOX.FRX:23EA PictureDnChange = 0 'Use 'PictureUp' Bitmap Unchanged PictureUp = MSGBOX.FRX:2C24 Top = 270 Width = 570 End Begin SSRibbon gpbIcon BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 570 Index = 1 Left = 1320 PictureDisabled = MSGBOX.FRX:345E PictureDnChange = 0 'Use 'PictureUp' Bitmap Unchanged PictureUp = MSGBOX.FRX:3C98 Top = 270 Width = 570 End Begin SSRibbon gpbIcon BackColor = &H00C0C0C0& GroupAllowAllUp = 0 'False Height = 570 Index = 0 Left = 240 PictureDisabled = MSGBOX.FRX:44D2 PictureDnChange = 0 'Use 'PictureUp' Bitmap Unchanged PictureUp = MSGBOX.FRX:4D0C Top = 270 Width = 570 End Begin Label lblIcons AutoSize = -1 'True Caption = "No Icon" Height = 195 Index = 4 Left = 4485 TabIndex = 36 Top = 870 Width = 690 End Begin Label lblIcons AutoSize = -1 'True Caption = "I&nformation" Height = 195 Index = 3 Left = 3310 TabIndex = 35 Top = 870 Width = 960 End Begin Label lblIcons AutoSize = -1 'True Caption = "E&xclamation" Height = 195 Index = 2 Left = 2190 TabIndex = 34 Top = 870 Width = 1035 End Begin Label lblIcons AutoSize = -1 'True Caption = "&Question" Height = 195 Index = 1 Left = 1245 TabIndex = 33 Top = 870 Width = 765 End Begin Label lblIcons AutoSize = -1 'True Caption = "S&top" Height = 195 Index = 0 Left = 310 TabIndex = 32 Top = 855 Width = 405 End End Begin SSFrame f3dButtons Caption = "Buttons" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 1965 Left = 90 TabIndex = 9 Top = 1600 Width = 2250 Begin SSOption o3dButtons Caption = "&Retry/Cancel" Font3D = 0 'None Height = 240 Index = 5 Left = 210 TabIndex = 14 TabStop = 0 'False Top = 1640 Width = 1950 End Begin SSOption o3dButtons Caption = "Y&es/No" Font3D = 0 'None Height = 240 Index = 4 Left = 210 TabIndex = 13 TabStop = 0 'False Top = 1350 Width = 1950 End Begin SSOption o3dButtons Caption = "&Yes/No/Cancel" Font3D = 0 'None Height = 240 Index = 3 Left = 210 TabIndex = 12 TabStop = 0 'False Top = 1060 Width = 1950 End Begin SSOption o3dButtons Caption = "&Abort/Retry/Ignore" Font3D = 0 'None Height = 240 Index = 2 Left = 210 TabIndex = 11 TabStop = 0 'False Top = 775 Width = 1950 End Begin SSOption o3dButtons Caption = "O&K/Cancel" Font3D = 0 'None Height = 240 Index = 1 Left = 210 TabIndex = 10 TabStop = 0 'False Top = 500 Width = 1950 End Begin SSOption o3dButtons Caption = "&OK" Font3D = 0 'None Height = 240 Index = 0 Left = 210 TabIndex = 3 Top = 225 Value = -1 'True Width = 1950 End End Begin SSFrame f3dProcedure Caption = "Procedure Type" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 1485 Left = 90 MousePointer = 1 'Arrow TabIndex = 21 Tag = "Choose to use either MsbBox statement or MsgBox() function" Top = 60 Width = 2250 Begin SSCheck x3dDimMsg Caption = "&Dim Msg$" Font3D = 0 'None ForeColor = &H00000000& Height = 240 Left = 450 TabIndex = 37 TabStop = 0 'False Top = 840 Value = -1 'True Width = 1665 End Begin SSCheck x3dDimResponse Caption = "&Dim Response%" Enabled = 0 'False Font3D = 0 'None ForeColor = &H00000000& Height = 240 Left = 435 TabIndex = 8 TabStop = 0 'False Top = 1125 Width = 1665 End Begin SSOption o3dProcedureType Caption = "MsgBox() &Function" Enabled = 0 'False Font3D = 0 'None Height = 240 Index = 1 Left = 195 TabIndex = 7 TabStop = 0 'False Top = 570 Width = 1890 End Begin SSOption o3dProcedureType Caption = "MsgBox &Statement" Font3D = 0 'None Height = 240 Index = 0 Left = 200 TabIndex = 2 Tag = "275" Top = 275 Value = -1 'True Width = 1890 End End Begin SSFrame f3dTextFields Caption = "Text Strings" Font3D = 3 'Inset w/light shading ForeColor = &H00000000& Height = 2145 Left = 2445 TabIndex = 18 Top = 60 Width = 5325 Begin SSPanel Panel3D2 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BevelOuter = 0 'None BorderWidth = 1 Caption = "Panel3D2" Font3D = 0 'None Height = 300 Left = 165 RoundedCorners = 0 'False TabIndex = 20 Top = 480 Width = 5115 Begin TextBox txtTitleField BorderStyle = 0 'None Height = 225 Left = 60 TabIndex = 0 Top = 45 Width = 5010 End End Begin SSPanel Panel3D1 BackColor = &H00C0C0C0& BevelInner = 1 'Inset BevelOuter = 0 'None BorderWidth = 1 Caption = "Panel3D1" Font3D = 0 'None Height = 1005 Left = 165 RoundedCorners = 0 'False TabIndex = 19 Top = 1080 Width = 5115 Begin TextBox txtMsgField BorderStyle = 0 'None Height = 930 Left = 60 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 1 Top = 30 Width = 5025 End End Begin Label lblMessage AutoSize = -1 'True Caption = "&Message (Msg)" Height = 195 Left = 180 TabIndex = 31 Top = 855 Width = 1290 End Begin Label lblTitle AutoSize = -1 'True Caption = "T&itle" Height = 195 Left = 165 TabIndex = 30 Top = 255 Width = 390 End End End Option Explicit Dim MBV As MBValue 'User defined Dim iDefVal As Integer Dim iSaveDimResponse As Integer Dim iSelected_Buttons As Integer Dim CRLF As String Sub c3dActions_Click (Index As Integer) On Error GoTo ACTIONerr iDefVal = MBV.Buttons + MBV.ICON + MBV.MODAL + MBV.DefButton Dim Msg As String Dim sTempMsg As String Select Case Index 'paste to window/clipboard Case 0, 1: Dim sCBtext As String Dim VBhWnd As Integer, FORMhWnd As Integer 'VB program & form hWnd Dim iNumTextLines As Integer, iRet As Integer 'iNumTextLines = # of lines to mark after paste Dim i As Integer, j As Integer ClipBoard.Clear 'Clear Clipboard. sCBtext = "'start_insert ---------------------" & CRLF iNumTextLines = 1 If x3dDimMsg.Value Then sCBtext = sCBtext & "Dim Msg As String" & CRLF iNumTextLines = iNumTextLines + 1 End If If x3dDimResponse.Value Then sCBtext = sCBtext & "Dim Response As Integer" & CRLF iNumTextLines = iNumTextLines + 1 End If 'If Main!Text2.Text > "" Then j = 1 For i = 1 To SendMessage(txtMsgField.hWnd, EM_GETLINECOUNT, 0, 0) sTempMsg = Mid$(txtMsgField, j, SendMessage(txtMsgField.hWnd, EM_LINELENGTH, j, 0)) j = j + SendMessage(txtMsgField.hWnd, EM_LINELENGTH, j, 0) + 2 If sTempMsg <> "" Then sCBtext = sCBtext & "Msg = Msg & " & Chr$(34) & sTempMsg & Chr$(34) & " & Chr$(13) & Chr$(10)" & CRLF Else sCBtext = sCBtext & "Msg = Msg & Chr$(13) & Chr$(10)" & CRLF End If iNumTextLines = iNumTextLines + 1 sTempMsg = "" Next If o3dProcedureType(1).Value Then 'Function sCBtext = sCBtext & "Response = MsgBox(Msg, " & CStr(iDefVal) & ", " & Chr$(34) & txtTitleField & Chr$(34) & ")" & CRLF iNumTextLines = iNumTextLines + 1 For i = 0 To 2 'process the selected 'default button' first If o3dDefaultButton(i).Value Then j = i sCBtext = sCBtext & "If Response = " & o3dDefaultButton(i).Tag & " then '" & Mid$(o3dDefaultButton(i).Caption, 6, Len(o3dDefaultButton(i).Caption)) & CRLF iNumTextLines = iNumTextLines + 1 Exit For End If Next For i = 0 To 2 '3 default button selections... process the remaining 2 If i <> j Then If o3dDefaultButton(i).Visible Then sCBtext = sCBtext & "ElseIf Response = " & o3dDefaultButton(i).Tag & " then '" & Mid$(o3dDefaultButton(i).Caption, 6, Len(o3dDefaultButton(i).Caption)) & CRLF iNumTextLines = iNumTextLines + 1 End If End If Next sCBtext = sCBtext & "End If" & CRLF iNumTextLines = iNumTextLines + 1 'Debug.Print sCBtext Else 'Statement sCBtext = sCBtext & "MsgBox Msg, " & CStr(iDefVal) & ", " & Chr$(34) & txtTitleField & Chr$(34) & CRLF iNumTextLines = iNumTextLines + 1 End If sCBtext = sCBtext & "'end_insert -----------------------" & CRLF iNumTextLines = iNumTextLines + 1 ClipBoard.SetText sCBtext, 1 End Select Select Case Index '-paste to window Case 0: VBhWnd = FindWindow("wndclass_desked_gsk", 0&) If VBhWnd = 0 Then ' iRet = WinExec("C:\VB\VB", 0) ' VBhWnd = FindWindow(TEXTWINDOW, 0&) ' If VBhWnd = 0 Then MsgBox "No open code windows to write to!" & CRLF & "Code has been copied to Clipboard!", MB_ICONINFORMATION, "COPIED" 'MsgBox "Unable to launch Visual Basic" GoTo ACTIONend ' End If End If 'AppActivate "Microsoft Visual Basic [run]" 'use when in vb environment 'AppActivate "Microsoft Visual Basic [design]" 'use when compiling AppActivate "Microsoft Visual Basic" '**use when compiling** FORMhWnd = FindWindow("OEBDebug", 0&) If FORMhWnd = 0 Then FORMhWnd = FindWindow("OModule", 0&) If FORMhWnd = 0 Then MsgBox "No open code windows to write to!" & CRLF & "Code has been copied to Clipboard!", MB_ICONINFORMATION, "COPIED" GoTo ACTIONend End If End If ''wHandle = GetActiveWindow() 'Dim ClassLen As Integer, ClassName As String, MaxCount As Integer 'MaxCount = 128 'ClassName = String$(128, 0) ''ClassLen = GetClassName(wHandle, ClassName, MaxCount) 'ClassLen = GetClassName(hWnd, ClassName, MaxCount) 'MsgBox Left$(ClassName, ClassLen) & " " & CStr(hWnd) iRet = SetFocusAPI(VBhWnd) 'give focus to VB RestoreApp (VBhWnd) 'if VB minimized, restore RestoreApp (FORMhWnd) 'if VB's form minimized, restore SendKeys "%EP", True '{Alt E,P} keystrokes to paste back the new text iRet = SetFocusAPI(FORMhWnd) 'give focus to the form SendKeys "+{UP " & Format$(iNumTextLines) & "}", True 'mark pasted lines (from bottom up) 'WindowState = 1 'minimize MsgBox.PROGRAM after window paste '-paste to clipboard Case 1: MsgBox "Code has been copied to Clipboard!", MB_ICONINFORMATION, "COPIED" '-view msgbox Case 2: MsgBox txtMsgField.Text, iDefVal, txtTitleField.Text '-exit Case 3: Unload Me End Select ACTIONend: Exit Sub ACTIONerr: ShowError Resume ACTIONend End Sub Sub Form_KeyUp (KeyCode As Integer, Shift As Integer) '-set focus on object, per label letter underscores Select Case Shift Case 4 'alt Select Case KeyCode Case 73: 'i/I (title) txtTitleField.SetFocus Case 77: 'm/M txtMsgField.SetFocus Case 84: 't/T (stop) If gpbIcon(0).Enabled Then gpbIcon(0).Value = True End If Case 81: 'q/Q (question) If gpbIcon(1).Enabled Then gpbIcon(1).Value = True End If Case 88: 'x/X (exclamation) If gpbIcon(2).Enabled Then gpbIcon(2).Value = True End If Case 78: 'n/N (information) If gpbIcon(3).Enabled Then gpbIcon(3).Value = True End If End Select End Select End Sub Sub Form_Load () CRLF = Chr$(13) & Chr$(10) iSaveDimResponse = False 'initial value Call o3dButtons_Click(0, True) 'initiate OK End Sub Sub Form_Unload (Cancel As Integer) Dim Response As Integer Response = MsgBox("Are you sure?", 36, "EXIT?") If Response = 6 Then 'YES End Const NoExit = 1 Cancel = NoExit End If End Sub Sub gpbIcon_Click (Index As Integer, Value As Integer) Select Case Index Case 0: MBV.ICON = MB_ICONSTOP Case 1: MBV.ICON = MB_ICONQUESTION Case 2: MBV.ICON = MB_ICONEXCLAMATION Case 3: MBV.ICON = MB_ICONINFORMATION Case 4: MBV.ICON = 0 End Select 'iDefVal = MBV.Buttons + MBV.ICON + MBV.MODAL + MBV.DefButton End Sub Sub o3dButtons_Click (Index As Integer, Value As Integer) iSelected_Buttons = Index Dim iJ As Integer Dim iNumButtons As Integer iNumButtons = 2 'default o3dDefaultButton(1).Value = True '2nd button on (default) Select Case Index Case 0: MBV.Buttons = MB_OK iNumButtons = 1 o3dDefaultButton(0).Value = True '1st button on o3dDefaultButton(0).Caption = "&1st--OK" o3dDefaultButton(0).Tag = IDOK Case 1: MBV.Buttons = MB_OKCANCEL o3dDefaultButton(0).Caption = "&1st--OK" o3dDefaultButton(0).Tag = IDOK o3dDefaultButton(1).Caption = "&2nd--Cancel" o3dDefaultButton(1).Tag = IDCANCEL Case 2: MBV.Buttons = MB_ABORTRETRYIGNORE iNumButtons = 3 o3dDefaultButton(0).Caption = "&1st--Abort" o3dDefaultButton(0).Tag = IDABORT o3dDefaultButton(1).Caption = "&2nd--Retry" o3dDefaultButton(1).Tag = IDRETRY o3dDefaultButton(2).Caption = "&3nd--Ignore" o3dDefaultButton(2).Tag = IDIGNORE Case 3: MBV.Buttons = MB_YESNOCANCEL iNumButtons = 3 o3dDefaultButton(0).Caption = "&1st--Yes" o3dDefaultButton(0).Tag = IDYES o3dDefaultButton(1).Caption = "&2nd--No" o3dDefaultButton(1).Tag = IDNO o3dDefaultButton(2).Caption = "&3nd--Cancel" o3dDefaultButton(2).Tag = IDCANCEL Case 4: MBV.Buttons = MB_YESNO o3dDefaultButton(0).Caption = "&1st--Yes" o3dDefaultButton(0).Tag = IDYES o3dDefaultButton(1).Caption = "&2nd--No" o3dDefaultButton(1).Tag = IDNO Case 5: MBV.Buttons = MB_RETRYCANCEL o3dDefaultButton(0).Caption = "&1st--Retry" o3dDefaultButton(0).Tag = IDRETRY o3dDefaultButton(1).Caption = "&2nd--Cancel" o3dDefaultButton(1).Tag = IDCANCEL End Select For iJ = 1 To 2 If iJ < iNumButtons Then 'all buttons below iNumButtons on ' o3dDefaultButton(iJ).Value = True o3dDefaultButton(iJ).Visible = True Else 'all buttons above iNumButtons off o3dDefaultButton(iJ).Value = False o3dDefaultButton(iJ).Visible = False End If Select Case Index Case 0: 'OK requires statement (only one button... no return value) o3dProcedureType(0).Enabled = True 'MsgBox Statement on o3dProcedureType(0).Value = True o3dProcedureType(1).Value = False 'MsgBox Function off o3dProcedureType(1).Enabled = False iSaveDimResponse = x3dDimResponse.Value 'save user selection prior to turning off x3dDimResponse.Value = False 'Dim Response off x3dDimResponse.Enabled = False Case Is > 0 'All others require function (multi-button... requiring return code) o3dProcedureType(0).Enabled = False 'MsgBox Statement off o3dProcedureType(0).Value = False o3dProcedureType(1).Value = True 'MsgBox Function on o3dProcedureType(1).Enabled = True x3dDimResponse.Value = iSaveDimResponse 'Dim Response (value to previous state) x3dDimResponse.Enabled = True 'Dim Response on End Select 'iDefVal = MBV.Buttons + MBV.ICON + MBV.MODAL + MBV.DefButton End Sub Sub o3dDefaultButton_Click (Index As Integer, Value As Integer) Select Case Index Case 0: MBV.DefButton = MB_DEFBUTTON1 Case 1: MBV.DefButton = MB_DEFBUTTON2 Case 2: MBV.DefButton = MB_DEFBUTTON3 End Select 'iDefVal = MBV.Buttons + MBV.ICON + MBV.MODAL + MBV.DefButton End Sub Sub o3dModality_Click (Index As Integer, Value As Integer) Dim iJ As Integer Select Case Index Case 0: f3dIcon.Enabled = True 'APPLICATION MODAL For iJ = 0 To 3 gpbIcon(iJ).Enabled = True lblIcons(iJ).Enabled = True Next gpbIcon(4).Value = True 'Depress 'No Icon' MBV.MODAL = MB_APPLMODAL Case 1: f3dIcon.Enabled = False 'SYSTEM MODAL For iJ = 0 To 3 gpbIcon(iJ).Value = True gpbIcon(iJ).Enabled = False lblIcons(iJ).Enabled = False Next gpbIcon(4).Value = True 'Depress 'No Icon' MBV.MODAL = MB_SYSTEMMODAL End Select 'iDefVal = MBV.Buttons + MBV.ICON + MBV.MODAL + MBV.DefButton End Sub Sub RestoreApp (wHandle As Integer) Const WM_SYSCOMMAND = &H112 Const SC_RESTORE = &HF120 Dim t As Integer If IsIconic(wHandle) Then t = PostMessage(wHandle, WM_SYSCOMMAND, SC_RESTORE, 0) Call WaitSecs(1) End If End Sub Sub ShowError () Dim Msg As String Msg = "The following Error occurred:" & CRLF & CRLF Msg = Msg & Error$ & CRLF & CRLF Msg = Msg & "Number: " & CStr(Err) & CRLF 'add the error number MsgBox Msg, , "E R R O R !" End Sub Sub WaitSecs (secs As Integer) Dim start As Single, Temp As Integer start = Timer While Timer < start + secs + 1 Temp = DoEvents() End Sub